home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
lsp
/
defmacro.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
17KB
|
864 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "defmacro.h"
init_defmacro(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
VV[0]->s.s_stype=(short)stp_special;
VV[1]->s.s_stype=(short)stp_special;
VV[2]->s.s_stype=(short)stp_special;
MF(VV[54],L1,start,size,data);
MF(VV[55],L2,start,size,data);
MF(VV[56],L3,start,size,data);
MF(VV[57],L4,start,size,data);
MF(VV[58],L5,start,size,data);
MF(VV[59],L6,start,size,data);
MF(VV[60],L7,start,size,data);
MF(VV[61],L8,start,size,data);
MF(VV[62],L9,start,size,data);
MF(VV[63],L10,start,size,data);
MF(VV[64],L11,start,size,data);
vs_top=vs_base=base;
}
/* function definition for DEFMACRO* */
static L1()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
bds_check;
check_arg(3);
vs_top=sup;
TTL:;
bds_bind(VV[0],Cnil);
bds_bind(VV[1],Cnil);
bds_bind(VV[2],Cnil);
base[6]= Cnil;
base[7]= Cnil;
base[8]= Cnil;
base[9]= Cnil;
base[10]= Cnil;
base[11]= Cnil;
base[12]= (type_of(base[1])==t_cons||base[1]==Cnil?Ct:Cnil);
if((base[12])==Cnil){
goto T4;}
goto T1;
T4:;
if(!(type_of(base[1])==t_symbol)){
goto T7;}
base[1]= list(2,VV[3],base[1]);
goto T1;
T7:;
base[13]= VV[4];
base[14]= base[1];
vs_top=(vs_base=base+13)+2;
Lerror();
vs_top=sup;
T1:;
base[12]= base[2];
base[13]= Cnil;
vs_top=(vs_base=base+12)+2;
L10();
if(vs_base<vs_top){
base[6]= vs_base[0];
vs_base++;
}else{
base[6]= Cnil;}
if(vs_base<vs_top){
base[7]= vs_base[0];
vs_base++;
}else{
base[7]= Cnil;}
if(vs_base<vs_top){
base[2]= vs_base[0];
}else{
base[2]= Cnil;}
vs_top=sup;
if(!(type_of(base[1])==t_cons||base[1]==Cnil)){
goto T18;}
if(!(car(base[1])==VV[5])){
goto T18;}
base[8]= cadr(base[1]);
base[1]= cddr(base[1]);
goto T16;
T18:;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[8]= vs_base[0];
T16:;
if(!(type_of(base[1])==t_cons||base[1]==Cnil)){
goto T28;}
if(!(car(base[1])==VV[6])){
goto T28;}
base[10]= cadr(base[1]);
base[1]= cddr(base[1]);
base[11]= Ct;
goto T26;
T28:;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[10]= vs_base[0];
T26:;
(VV[0]->s.s_dbind)= list(3,VV[7],base[10],base[8]);
base[12]= base[1];
base[13]= base[8];
base[14]= Ct;
vs_top=(vs_base=base+12)+3;
L2();
vs_top=sup;
base[9]= vs_base[0];
base[12]= (VV[1]->s.s_dbind);
base[13]= car(base[12]);
T48:;
if(!(endp(base[12]))){
goto T49;}
goto T45;
T49:;
base[14]= list(3,VV[9],car(base[13]),VV[10]);
base[15]= list(3,VV[12],car(base[13]),VV[13]);
base[16]= make_cons(base[15],Cnil);
base[17]= list(2,VV[17],cdr(base[13]));
base[18]= list(3,VV[15],VV[16],base[17]);
base[19]= list(3,VV[8],base[18],VV[18]);
base[20]= list(4,VV[11],base[16],VV[14],base[19]);
base[21]= list(3,VV[8],base[14],base[20]);
base[2]= make_cons(base[21],base[2]);
base[12]= cdr(base[12]);
base[13]= car(base[12]);
goto T48;
T45:;
base[12]= (VV[2]->s.s_dbind);
base[13]= car(base[12]);
T63:;
if(!(endp(base[12]))){
goto T64;}
goto T60;
T64:;
base[15]= cdr(base[13]);
base[16]= car(base[13]);
vs_top=(vs_base=base+15)+2;
L5();
vs_top=sup;
base[14]= vs_base[0];
base[15]= list(2,VV[19],base[14]);
base[16]= list(3,VV[8],base[15],VV[20]);
base[2]= make_cons(base[16],base[2]);
base[12]= cdr(base[12]);
base[13]= car(base[12]);
goto T63;
T60:;
if((base[11])!=Cnil){
goto T78;}
base[12]= list(2,VV[22],base[10]);
base[13]= list(2,VV[21],base[12]);
base[2]= make_cons(base[13],base[2]);
T78:;
base[12]= reverse((VV[0]->s.s_dbind));
base[13]= append(base[7],base[2]);
base[14]= listA(4,VV[23],base[0],base[12],base[13]);
base[15]= list(3,base[6],base[9],base[14]);
vs_top=(vs_base=base+15)+1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
return;
}
/* function definition for DM-VL */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
check_arg(3);
vs_top=sup;
TTL:;
if((base[2])==Cnil){
goto T84;}
base[12]= VV[24];
goto T82;
T84:;
base[12]= VV[25];
T82:;
base[3]= Cnil;
base[4]= Cnil;
base[5]= Cnil;
base[6]= Cnil;
base[7]= Cnil;
base[8]= Cnil;
base[9]= Cnil;
base[10]= Cnil;
base[11]= Cnil;
base[13]= Cnil;
T87:;
if(type_of(base[0])==t_cons){
goto T88;}
if((base[0])==Cnil){
goto T91;}
if((base[4])==Cnil){
goto T94;}
base[14]= VV[3];
vs_top=(vs_base=base+14)+1;
L6();
vs_top=sup;
T94:;
base[15]= base[12];
base[16]= base[1];
vs_top=(vs_base=base+15)+2;
L5();
vs_top=sup;
base[14]= vs_base[0];
base[15]= list(2,base[0],base[14]);
setq(VV[0],make_cons(base[15],symbol_value(VV[0])));
base[11]= Ct;
T91:;
if((base[8])==Cnil){
goto T104;}
if((base[9])!=Cnil){
goto T104;}
base[14]= make_cons(base[8],base[10]);
setq(VV[1],make_cons(base[14],symbol_value(VV[1])));
T104:;
if((base[11])!=Cnil){
goto T110;}
base[14]= make_cons(base[1],base[12]);
setq(VV[2],make_cons(base[14],symbol_value(VV[2])));
T110:;
vs_top=(vs_base=base+13)+1;
return;
T88:;
base[14]= car(base[0]);
if(!(base[14]==VV[26])){
goto T118;}
if((base[3])==Cnil){
goto T120;}
base[15]= VV[26];
vs_top=(vs_base=base+15)+1;
L6();
vs_top=sup;
T120:;
base[3]= Ct;
base[15]= car(base[0]);
base[0]= cdr(base[0]);
goto T115;
T118:;
if(base[14]==VV[3]){
goto T129;}
if(!(base[14]==VV[27])){
goto T130;}
T129:;
if((base[4])==Cnil){
goto T134;}
base[15]= base[14];
vs_top=(vs_base=base+15)+1;
L6();
vs_top=sup;
T134:;
base[15]= cadr(base[0]);
base[17]= base[12];
base[18]= base[1];
vs_top=(vs_base=base+17)+2;
L5();
vs_top=sup;
base[16]= vs_base[0];
vs_top=(vs_base=base+15)+2;
L3();
vs_top=sup;
base[4]= Ct;
base[3]= Ct;
base[11]= Ct;
base[0]= cddr(base[0]);
if(!(base[14]==VV[27])){
goto T115;}
if((base[2])==Cnil){
goto T155;}
base[13]= one_minus(base[12]);
goto T153;
T155:;
base[13]= base[12];
T153:;
goto T115;
T130:;
if(!(base[14]==VV[28])){
goto T158;}
if((base[5])==Cnil){
goto T160;}
base[15]= VV[28];
vs_top=(vs_base=base+15)+1;
L6();
vs_top=sup;
T160:;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[8]= vs_base[0];
base[16]= base[12];
base[17]= base[1];
vs_top=(vs_base=base+16)+2;
L5();
vs_top=sup;
base[15]= vs_base[0];
base[16]= list(2,base[8],base[15]);
setq(VV[0],make_cons(base[16],symbol_value(VV[0])));
base[5]= Ct;
base[4]= Ct;
base[3]= Ct;
base[11]= Ct;
base[15]= car(base[0]);
base[0]= cdr(base[0]);
goto T115;
T158:;
if(!(base[14]==VV[29])){
goto T183;}
if((base[5])==Cnil){
goto T186;}
if((base[6])==Cnil){
goto T185;}
T186:;
base[15]= VV[29];
vs_top=(vs_base=base+15)+1;
L6();
vs_top=sup;
T185:;
base[6]= Ct;
base[9]= Ct;
base[15]= car(base[0]);
base[0]= cdr(base[0]);
goto T115;
T183:;
if(!(base[14]==VV[7])){
goto T199;}
if((base[7])==Cnil){
goto T201;}
base[15]= VV[7];
vs_top=(vs_base=base+15)+1;
L6();
vs_top=sup;
T201:;
base[7]= Ct;
base[6]= Ct;
base[5]= Ct;
base[4]= Ct;
base[3]= Ct;
base[15]= car(base[0]);
base[0]= cdr(base[0]);
goto T115;
T199:;
if((base[7])==Cnil){
goto T219;}
base[15]= Cnil;
base[16]= Cnil;
if(!(type_of(base[14])==t_symbol)){
goto T224;}
base[15]= base[14];
goto T222;
T224:;
base[15]= car(base[14]);
if(endp(cdr(base[14]))){
goto T222;}
base[16]= cadr(base[14]);
T222:;
base[17]= base[15];
base[18]= base[16];
vs_top=(vs_base=base+17)+2;
L3();
vs_top=sup;
base[15]= car(base[0]);
base[0]= cdr(base[0]);
goto T115;
T219:;
if((base[5])==Cnil){
goto T238;}
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[15]= vs_base[0];
base[16]= Cnil;
base[17]= Cnil;
base[18]= Cnil;
base[19]= Cnil;
if(!(type_of(base[14])==t_symbol)){
goto T244;}
base[16]= base[14];
base[20]= coerce_to_string(base[14]);
base[21]= VV[30];
vs_top=(vs_base=base+20)+2;
Lintern();
vs_top=sup;
base[17]= vs_base[0];
goto T242;
T244:;
if(!(type_of(car(base[14]))==t_symbol)){
goto T253;}
base[16]= car(base[14]);
base[20]= coerce_to_string(car(base[14]));
base[21]= VV[30];
vs_top=(vs_base=base+20)+2;
Lintern();
vs_top=sup;
base[17]= vs_base[0];
goto T251;
T253:;
base[16]= cadar(base[14]);
base[17]= caar(base[14]);
T251:;
if(endp(cdr(base[14]))){
goto T242;}
base[18]= cadr(base[14]);
if(endp(cddr(base[14]))){
goto T242;}
base[19]= caddr(base[14]);
T242:;
base[20]= base[15];
base[21]= list(4,VV[9],base[8],base[17],VV[31]);
vs_top=(vs_base=base+20)+2;
L3();
vs_top=sup;
base[20]= base[16];
base[22]= list(3,VV[33],base[15],VV[34]);
base[21]= list(4,VV[32],base[22],base[18],base[15]);
vs_top=(vs_base=base+20)+2;
L3();
vs_top=sup;
if((base[19])==Cnil){
goto T276;}
base[20]= base[19];
base[22]= list(3,VV[33],base[15],VV[36]);
base[21]= list(2,VV[35],base[22]);
vs_top=(vs_base=base+20)+2;
L3();
vs_top=sup;
T276:;
base[10]= make_cons(base[17],base[10]);
base[15]= car(base[0]);
base[0]= cdr(base[0]);
goto T115;
T238:;
if((base[3])==Cnil){
goto T286;}
base[15]= Cnil;
base[16]= Cnil;
base[17]= Cnil;
if(!(type_of(base[14])==t_symbol)){
goto T291;}
base[15]= base[14];
goto T289;
T291:;
base[15]= car(base[14]);
if(endp(cdr(base[14]))){
goto T289;}
base[16]= cadr(base[14]);
if(endp(cddr(base[14]))){
goto T289;}
base[17]= caddr(base[14]);
T289:;
base[18]= base[15];
base[21]= base[12];
base[22]= base[1];
vs_top=(vs_base=base+21)+2;
L5();
vs_top=sup;
base[20]= vs_base[0];
base[22]= base[12];
base[23]= base[1];
vs_top=(vs_base=base+22)+2;
L4();
vs_top=sup;
base[21]= vs_base[0];
base[19]= list(4,VV[32],base[20],base[21],base[16]);
vs_top=(vs_base=base+18)+2;
L3();
vs_top=sup;
if((base[17])==Cnil){
goto T288;}
base[18]= base[17];
base[21]= base[12];
base[22]= base[1];
vs_top=(vs_base=base+21)+2;
L5();
vs_top=sup;
base[20]= vs_base[0];
base[21]= list(2,VV[37],base[20]);
base[19]= list(2,VV[35],base[21]);
vs_top=(vs_base=base+18)+2;
L3();
vs_top=sup;
T288:;
base[12]= number_plus(base[12],VV[24]);
base[15]= car(base[0]);
base[0]= cdr(base[0]);
goto T115;
T286:;
base[15]= base[14];
base[18]= base[12];
base[19]= base[1];
vs_top=(vs_base=base+18)+2;
L5();
vs_top=sup;
base[17]= vs_base[0];
base[19]= base[12];
base[20]= base[1];
vs_top=(vs_base=base+19)+2;
L4();
vs_top=sup;
base[18]= vs_base[0];
base[16]= list(4,VV[32],base[17],base[18],VV[38]);
vs_top=(vs_base=base+15)+2;
L3();
vs_top=sup;
base[12]= number_plus(base[12],VV[24]);
base[15]= car(base[0]);
base[0]= cdr(base[0]);
T115:;
goto T87;
}
/* function definition for DM-V */
static L3()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(2);
vs_top=sup;
TTL:;
if(!(type_of(base[0])==t_symbol)){
goto T341;}
if((base[1])==Cnil){
goto T346;}
base[2]= list(2,base[0],base[1]);
goto T344;
T346:;
base[2]= base[0];
T344:;
setq(VV[0],make_cons(base[2],symbol_value(VV[0])));
base[2]= symbol_value(VV[0]);
vs_top=(vs_base=base+2)+1;
return;
T341:;
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[2]= vs_base[0];
if((base[1])==Cnil){
goto T353;}
base[3]= list(2,base[2],base[1]);
goto T351;
T353:;
base[3]= base[2];
T351:;
setq(VV[0],make_cons(base[3],symbol_value(VV[0])));
base[3]= base[0];
base[4]= base[2];
base[5]= Cnil;
vs_top=(vs_base=base+3)+3;
L2();
return;
}
/* function definition for DM-NTH */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
check_arg(2);
vs_top=sup;
TTL:;
base[3]= base[0];
base[4]= VV[39];
vs_top=(vs_base=base+3)+2;
Lfloor();
Llist();
vs_top=sup;
base[2]= vs_base[0];
base[3]= car(base[2]);
base[4]= cadr(base[2]);
base[5]= VV[25];
T366:;
if(!(number_compare(base[5],base[3])>=0)){
goto T367;}
goto T364;
T367:;
base[1]= list(2,VV[40],base[1]);
base[5]= one_plus(base[5]);
goto T366;
T364:;
{object V1= base[4];
if(!eql(V1,VV[25]))goto T376;
base[5]= list(2,VV[41],base[1]);
vs_top=(vs_base=base+5)+1;
return;
T376:;
if(!eql(V1,VV[24]))goto T377;
base[5]= list(2,VV[42],base[1]);
vs_top=(vs_base=base+5)+1;
return;
T377:;
if(!eql(V1,VV[43]))goto T378;
base[5]= list(2,VV[44],base[1]);
vs_top=(vs_base=base+5)+1;
return;
T378:;
if(!eql(V1,VV[45]))goto T379;
base[5]= list(2,VV[46],base[1]);
vs_top=(vs_base=base+5)+1;
return;
T379:;
base[5]= Cnil;
vs_top=(vs_base=base+5)+1;
return;}
}
/* function definition for DM-NTH-CDR */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
check_arg(2);
vs_top=sup;
TTL:;
base[3]= base[0];
base[4]= VV[39];
vs_top=(vs_base=base+3)+2;
Lfloor();
Llist();
vs_top=sup;
base[2]= vs_base[0];
base[3]= car(base[2]);
base[4]= cadr(base[2]);
base[5]= VV[25];
T388:;
if(!(number_compare(base[5],base[3])>=0)){
goto T389;}
goto T386;
T389:;
base[1]= list(2,VV[40],base[1]);
base[5]= one_plus(base[5]);
goto T388;
T386:;
{object V2= base[4];
if(!eql(V2,VV[25]))goto T398;
vs_top=(vs_base=base+1)+1;
return;
T398:;
if(!eql(V2,VV[24]))goto T399;
base[5]= list(2,VV[47],base[1]);
vs_top=(vs_base=base+5)+1;
return;
T399:;
if(!eql(V2,VV[43]))goto T400;
base[5]= list(2,VV[48],base[1]);
vs_top=(vs_base=base+5)+1;
return;
T400:;
if(!eql(V2,VV[45]))goto T401;
base[5]= list(2,VV[49],base[1]);
vs_top=(vs_base=base+5)+1;
return;
T401:;
base[5]= Cnil;
vs_top=(vs_base=base+5)+1;
return;}
}
/* function definition for DM-BAD-KEY */
static L6()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= VV[50];
base[2]= base[0];
vs_top=(vs_base=base+1)+2;
Lerror();
return;
}
/* function definition for DM-TOO-FEW-ARGUMENTS */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
check_arg(0);
vs_top=sup;
TTL:;
base[0]= VV[51];
vs_top=(vs_base=base+0)+1;
Lerror();
return;
}
/* function definition for DM-TOO-MANY-ARGUMENTS */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
check_arg(0);
vs_top=sup;
TTL:;
base[0]= VV[52];
vs_top=(vs_base=base+0)+1;
Lerror();
return;
}
/* function definition for DM-KEY-NOT-ALLOWED */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= VV[53];
base[2]= base[0];
vs_top=(vs_base=base+1)+2;
Lerror();
return;
}
/* function definition for FIND-DOC */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM12;
vs_reserve(VM12);
check_arg(2);
vs_top=sup;
TTL:;
if(!(endp(base[0]))){
goto T409;}
base[2]= Cnil;
base[3]= Cnil;
base[4]= Cnil;
vs_base=base+2;vs_top=base+5;
return;
T409:;
base[3]= car(base[0]);
vs_top=(vs_base=base+3)+1;
Lmacroexpand();
vs_top=sup;
base[2]= vs_base[0];
if(!(type_of(base[2])==t_string)){
goto T417;}
if(endp(cdr(base[0]))){
goto T419;}
if((base[1])==Cnil){
goto T420;}
T419:;
base[3]= Cnil;
base[4]= Cnil;
base[5]= make_cons(base[2],cdr(base[0]));
vs_base=base+3;vs_top=base+6;
return;
T420:;
base[4]= cdr(base[0]);
base[5]= Ct;
vs_top=(vs_base=base+4)+2;
L10();
Llist();
vs_top=sup;
base[3]= vs_base[0];
base[4]= car(base[3]);
base[5]= cadr(base[3]);
base[6]= caddr(base[3]);
base[7]= base[2];
base[8]= base[5];
base[9]= base[6];
vs_base=base+7;vs_top=base+10;
return;
T417:;
if(!(type_of(base[2])==t_cons)){
goto T438;}
if(!(car(base[2])==VV[21])){
goto T438;}
base[4]= cdr(base[0]);
base[5]= base[1];
vs_top=(vs_base=base+4)+2;
L10();
Llist();
vs_top=sup;
base[3]= vs_base[0];
base[4]= car(base[3]);
base[5]= cadr(base[3]);
base[6]= caddr(base[3]);
base[7]= base[4];
base[8]= make_cons(base[2],base[5]);
base[9]= base[6];
vs_base=base+7;vs_top=base+10;
return;
T438:;
base[3]= Cnil;
base[4]= Cnil;
base[5]= make_cons(base[2],cdr(base[0]));
vs_base=base+3;vs_top=base+6;
return;
}
/* function definition for FIND-DECLARATIONS */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM13;
vs_reserve(VM13);
check_arg(1);
vs_top=sup;
TTL:;
if(!(endp(base[0]))){
goto T456;}
base[1]= Cnil;
base[2]= Cnil;
vs_base=base+1;vs_top=base+3;
return;
T456:;
base[2]= car(base[0]);
vs_top=(vs_base=base+2)+1;
Lmacroexpand();
vs_top=sup;
base[1]= vs_base[0];
if(!(type_of(base[1])==t_string)){
goto T463;}
if(!(endp(cdr(base[0])))){
goto T466;}
base[2]= Cnil;
base[3]= make_cons(base[1],Cnil);
vs_base=base+2;vs_top=base+4;
return;
T466:;
base[3]= cdr(base[0]);
vs_top=(vs_base=base+3)+1;
L11();
Llist();
vs_top=sup;
base[2]= vs_base[0];
base[3]= car(base[2]);
base[4]= cadr(base[2]);
base[5]= make_cons(base[1],base[3]);
base[6]= base[4];
vs_base=base+5;vs_top=base+7;
return;
T463:;
if(!(type_of(base[1])==t_cons)){
goto T478;}
if(!(car(base[1])==VV[21])){
goto T478;}
base[3]= cdr(base[0]);
vs_top=(vs_base=base+3)+1;
L11();
Llist();
vs_top=sup;
base[2]= vs_base[0];
base[3]= car(base[2]);
base[4]= cadr(base[2]);
base[5]= make_cons(base[1],base[3]);
base[6]= base[4];
vs_base=base+5;vs_top=base+7;
return;
T478:;
base[2]= Cnil;
base[3]= make_cons(base[1],cdr(base[0]));
vs_base=base+2;vs_top=base+4;
return;
}